perm filename III[G,BGB]2 blob
sn#025298 filedate 1973-02-20 generic text, type T, neo UTF8
00100 ;III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
00200 A←1↔B←2↔C←3
00300 INTERN DPYBUF↔DPYBUF:DPYBU.↔=2048 ↔ DPYBU.: BLOCK =2048
00400 IGNORE:0↔DPYPTR:0↔BUFEND:0
00500 BUFHD:0↔0;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
00600 ;--------------------------------------------------------------
00650 INTERN DPYSET,DPYOUT,DPYBRT,AIVECT,AVECT
00700 DPYSET: LAC 1,ARG1↔CDR 2,-1(1) ;BUFFER SIZE.
00800 ADDI 2,-1(1)↔DAC 2,BUFEND
00900 ADDI 1,2↔DAC 1,BUFHD ;POINT TO THIRD WORD.
01000 SETZM IGNORE
01100 CLR2: LAC A,BUFHD↔LACI B,1↔DAC B,1(A)
01200 LACI B,2(A)↔LIPI B,1(A)↔BLT B,@BUFEND
01300 PUSH P,(P)↔GO LV3
01400 ;--------------------------------------------------------------
01500 DPYBIG: SKIPE IGNORE↔POP1J
01600 LAC A,ARG1↔LACI C,46↔DPB A,[POINT 3,3,27]
01700 PUSH P,(P)↔GO LV2
01800
01900 DPYBRT: SKIPE IGNORE↔POP1J
02000 LAC 1,ARG1↔LACI C,46↔DPB A,[POINT 3,3,24]
02100 PUSH P,(P)↔GO LV2
02200 ;--------------------------------------------------------------
02300 AIVECT: SKIPA C,[146] ;INVISIBLE ABSOLUTE.
02400 AVECT: LACI C,106
02500 SKIPGE IGNORE↔POP2J
02600 LV: LAC A,ARG2↔LAC B,ARG1
02700 LVC: DPB A,[POINT 11,C,10]
02800 DPB B,[POINT 11,C,21]
02900 LV2: AOS A,DPYPTR↔DAC C,(A)
03000 LV3: LIPI A,<(<POINT 7,0,35>)>
03100 DAC A,DPYPTR↔LACI A,(A)
03200 CAML A,BUFEND↔SETOM IGNORE
03300 POP2J
03400 ;--------------------------------------------------------------
03500 DPYSTR: LAC 3,ARG1↔LIPI 3,440700
03600 ILDB 3↔JUMPE POP1J.
03700 CALL(DTYO,0)↔GO DPYSTR+2
03800
03900 DTYO: LAC 1,ARG1↔IDPB 1,DPYPTR
04000 CDR 1,DPYPTR↔CAML 1,BUFEND
04100 SETOM IGNORE↔POP1J
04200 ;--------------------------------------------------------------
04300 DPYOUT: SKIPN 1,BUFHD↔GO .+6
04400 LAC 2,DPYPTR↔DAC 2,-2(1)
04500 LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
04600 CDR B,DPYPTR↔SUB B,BUFHD
04700 AOS B↔DAC B,BUFHD+1
04800 LAC 1,ARG1↔DPB A,[POINT 4,.+1,12]↔703B8+BUFHD
04900 POP1J
05000 ;--------------------------------------------------------------
00100 SUBR(DECDPY)NUMBER------------------------------------------------
00200 BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
00300 LAC 1,ARG1↔POP P,ARG1 ;GET ARG AND ADJUST STACK.
00400 L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
00500 MOVM 2,1↔CALL(DTYO,["-"]) ;PRINT MINUS SIGN.
00600 LAC 1,2
00700 L2: IDIVI 1,12↔PUSH P,2 ;MODULO TEN AND SAVE.
00800 SKIPE 1↔PUSHJ P,L2 ;TEST FOR DONE.
00900 POP P,1↔ADDI 1,60↔CALL(DTYO,1) ;RESTORE & PRINT.
01000 POP0J
01100 BEND;12/17/72-----------------------------------------------------
01200
01300 SUBR(FLODPY)FLONUM,PLACES-----------------------------------------
01400 BEGIN FLODPY;FLOATING NUMBER DISPLAY - BGB - 4 FEB 1973.
01500 LAC ARG2↔JUMPL[CALL(DTYO,["-"])↔LACM ARG2↔GO .+1]
01600 LACM 2,ARG1↔CAILE 2,6↔LACI 2,6↔DAC 2,ARG1
01700 FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
01800 IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
01900 PUSH P,1↔CALL(DECDPY,0)↔POP P,0↔LAC 2,ARG1
02000 ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
02100 PUSH P,DPYPTR↔CALL(DECDPY,0)↔POP P,1
02200 LACI "."↔IDPB 0,1↔POP2J↔LIT
02300 BEND;2/4/73-------------------------------------------------------
00100 SUBR(IIIDPY)WORLD-------------------------------------------------
00200 BEGIN IIIDPY; DISPLAY DEVICE ROUTINE.
00300 ;BGB - 5 FEBRUARY 1973.
00400 E←←16
00500 CALL(DPYSET,DPYBUF)
00600 LAC E,ARG1
00700 L1: POTEN E,E ;CDR THRU THE VISIBLE EDGE LIST.
00800 JUMPE E,[
00900 CALL(DPYOUT,[1])
01000 POP1J] ;EXIT.
01100 X1DC 1,E↔Y1DC 2,E↔CALL(AIVECT,1,2)
01200 X2DC 1,E↔Y2DC 2,E↔CALL(AVECT,1,2)
01300 GO L1
01400 BEND;2/5/73-------------------------------------------------------
00100 ;VERNIER III TEXT POSITIONING.
00200 VERNX ←← 14
00300 VERNY ←← 11
00400 SUBR(VDPY)V-------------------------------------------------------
00500 BEGIN VDPY;SPECIAL VERTEX DISPLAY - BGB - 9 JANUARY 1973.
00600 LAC 1,ARG1↔CAR 0,(1)↔ANDI 0,017400 ;NSEW & PZZ.
00700 SKIPE↔POP1J
00800 XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
00900 YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
01000 CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01100 CALL(IDPY,ARG1)
01200 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
01300 POP1J
01400 BEND;2/9/73-------------------------------------------------------
01500
01600 SUBR(EDPY)E-------------------------------------------------------
01700 BEGIN EDPY;SPECIAL EDGE DISPLAY - BGB - 9 FEBRUARY 1973.
01800 CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01900 LAC 2,ARG1
02000 PVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L1
02100 XDC 0,1↔FIXX↔DAC X↔PUSH P,0
02200 YDC 0,1↔FIXX↔DAC Y↔PUSH P,0
02225 PUSH P,ARG1↔PUSH P,ARG1
02250 PUSHJ P,AIVECT
02300 CALL(DTYO,["+"])↔CALL(AIVECT)
02400 L1: LAC 2,ARG1
02500 NVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L2
02600 XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
02700 YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0↔PUSHJ P,AVECT
02800 CALL(DTYO,["-"])
02900 L2: LAC 2,ARG1
03000 LAC X↔ASH -1↔PUSH P,0
03100 LAC Y↔ASH -1↔PUSH P,0
03200 CALL(AIVECT)↔CALL(IDPY,ARG1)
03300 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
03400 POP1J
03450 DECLARE{X,Y}
03500 BEND;2/9/73-------------------------------------------------------
03600
00100 SUBR(FDPY)F-------------------------------------------------------
00200 BEGIN FDPY;SPECIAL FACE DISPLAY - BGB - 9 FEBRUARY 1973.
00300 LAC 1,ARG1↔DAC 1,F
00400 TEST 1,FBIT↔POP1J
00500 PED 2,1↔DAC 2,E↔DAC 2,E0
00700 SETZM I
00800 CALL(DPYBIG,[1])
00900 CALL(DPYBRT,[3])
00950 SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
01000 L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
01100 X1DC 0,2↔DAC 0,X
01200 Y1DC 1,2↔DAC 1,Y
01300 CALL(AIVECT,0,1)↔LAC 2,E
01400 X2DC 0,2↔ADDM 0,X
01500 Y2DC 1,2↔ADDM 1,Y
01600 CALL(AVECT,0,1)
01700 LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
01800 LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
01900 CALL(AIVECT,0,1)
02000 CALL(DECDPY,I)
02100 L2: CALL(ECCW,E,F)
02150 CAMN 1,E↔GO L3↔DAC 1,E
02200 CAME 1,E0↔GO L1
02300 L3: CALL(DPYBRT,[2])
02400 CALL(DPYBIG,[2])
02500 POP1J
02600 DECLARE{F,E,E0,X,Y,I}
02700 BEND;2/9/73-------------------------------------------------------
00100 END SA